home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / nexttsrc.lha / nexttsources / sources / comp / assembler / vaxi.t < prev    next >
Encoding:
Text File  |  1988-02-05  |  8.5 KB  |  258 lines
  1. (herald vaxi 
  2.         (env t (assembler as_open)))
  3.  
  4. ;;; Copyright (c) 1985 Yale University
  5. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  6. ;;; This material was developed by the T Project at the Yale University Computer 
  7. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  8. ;;; and to use it for any purpose is granted, subject to the following restric-
  9. ;;; tions and understandings.
  10. ;;; 1. Any copy made of this software must include this copyright notice in full.
  11. ;;; 2. Users of this software agree to make their best efforts (a) to return
  12. ;;;    to the T Project at Yale any improvements or extensions that they make,
  13. ;;;    so that these may be included in future releases; and (b) to inform
  14. ;;;    the T Project of noteworthy uses of this software.
  15. ;;; 3. All materials developed as a consequence of the use of this software
  16. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  17. ;;;    of acknowledging credit in academic research.
  18. ;;; 4. Yale has made no warrantee or representation that the operation of
  19. ;;;    this software will be error-free, and Yale is under no obligation to
  20. ;;;    provide any services, by way of maintenance, update, or otherwise.
  21. ;;; 5. In conjunction with products arising from the use of this material,
  22. ;;;    there shall be no use of the name of the Yale University nor of any
  23. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  24. ;;;    without prior written consent from Yale in each case.
  25. ;;;
  26.  
  27. ;;; Non branch VAX instruction field generators
  28.  
  29. (define-fg (vax$0op mnem opcode)
  30.   (printer "~a" (? mnem))
  31.   (f u 8 opcode))
  32.  
  33. (define-fg (vax$1op mnem opcode o1 oc1)
  34.   (printer "~a ~g" (? mnem) (? o1))
  35.   (f u 8 opcode)
  36.   (fg o1 oc1))
  37.  
  38. (define-fg (vax$disp mnem opcode d dw)
  39.   (printer "~a ~g" (? mnem) (? d))
  40.   (local dot)
  41.   (f u 8 opcode)
  42.   (f s dw (fixnum-ashr (from dot d) 3))
  43.   (mark dot))
  44.  
  45. (define-fg (vax$1op-disp mnem opcode o1 oc1 d dw)
  46.   (printer "~a ~g,~g" (? mnem) (? o1) (? d))
  47.   (local dot)
  48.   (f u 8 opcode)
  49.   (fg o1 oc1)
  50.   (f s dw (fixnum-ashr (from dot d) 3))
  51.   (mark dot))
  52.  
  53. (define-fg (vax$2op mnem opcode o1 oc1 o2 oc2)
  54.   (printer "~a ~g,~g" (? mnem) (? o1) (? o2))
  55.   (f u 8 opcode)
  56.   (fg o1 oc1)
  57.   (fg o2 oc2))
  58.  
  59. (define-fg (vax$2op-disp mnem opcode o1 oc1 o2 oc2 d dw)
  60.   (printer "~a ~g,~g,~g" (? mnem) (? o1) (? o2) (? d))
  61.   (local dot)
  62.   (f u 8 opcode)
  63.   (fg o1 oc1)
  64.   (fg o2 oc2)
  65.   (f s dw (fixnum-ashr (from dot d) 3))
  66.   (mark dot))
  67.  
  68. (define-fg (vax$3op mnem opcode o1 oc1 o2 oc2 o3 oc3)
  69.   (printer "~a ~g,~g,~g" (? mnem) (? o1) (? o2) (? o3))
  70.   (f u 8 opcode)
  71.   (fg o1 oc1)
  72.   (fg o2 oc2)
  73.   (fg o3 oc3))
  74.  
  75.    
  76. (define-fg (vax$3op-disp mnem opcode o1 oc1 o2 oc2 o3 oc3 d dw)
  77.   (printer "~a ~g,~g,~g,~g" (? mnem) (? o1) (? o2) (? o3) (? d))
  78.   (local dot)
  79.   (f u 8 opcode)
  80.   (fg o1 oc1)
  81.   (fg o2 oc2)
  82.   (fg o3 oc3)
  83.   (f s dw (fixnum-ashr (from dot d) 3))
  84.   (mark dot))
  85.  
  86.  
  87. (define-fg (vax$4op mnem opcode o1 oc1 o2 oc2 o3 oc3 o4 oc4)
  88.   (printer "~a ~g,~g,~g,~g" (? mnem) (? o1) (? o2) (? o3) (? o4))
  89.   (f u 8 opcode)
  90.   (fg o1 oc1)
  91.   (fg o2 oc2)
  92.   (fg o3 oc3)
  93.   (fg o4 oc4))
  94.  
  95.  
  96. ;;; BRANCH INSTRUCTION HANDLING
  97.  
  98. ;;; conditional branches
  99.  
  100. (define-fg (vax/jcc cc tag)
  101.   (printer "j~a    ~g" (jump-op-name (? cc)) (? tag))
  102.   (local dot displ field-width)
  103.   (depending-on (disp dot tag) 
  104.                 (choose-a-bcc (field-width 16) displ)
  105.                 (make-bcc-fg (? cc) (? field-width) (? displ)))
  106.   (mark dot))
  107.              
  108. (define (make-bcc-fg cc width displ)
  109.    (xcond ((fx= width 16) (vax/bcc-abs cc (fixnum-ashr displ 3)))
  110.           ((fx= width 40) (list (vax/bcc-abs (reverse-jump cc) 3)
  111.                                 (vax/brw-abs (fixnum-ashr displ 3))))
  112.           ((fx= width 64) (list (vax/bcc-abs (reverse-jump cc) 6)
  113.                                 (vax/jmp-abs (fixnum-ashr displ 3))))))
  114.  
  115.                                                
  116. ;;; Current width is the width of THIS field (by previous estimation), used in 
  117. ;;; determining the value of DISPL.  This only make a difference for backward
  118. ;;; jumps because the FGs definitions are set up to mark displacements from 
  119. ;;; after the DEPENDING-ON.
  120.  
  121. (define (choose-a-bcc current-width displ)
  122.   (cond ((fx< displ 0)
  123.          (let ((displ (fx+ displ current-width)))
  124.             (cond ((8bit-in-bits? (fx- displ 16)) (return 16 (fx- displ 16)))
  125.                   ((16bit-in-bits? (fx- displ 40)) (return 40 (fx- displ 40)))
  126.                   (else (return 64 (fx- displ 64))))))
  127.         (else
  128.          (cond ((8bit-in-bits? displ) (return 16 displ))
  129.                ((16bit-in-bits? displ) (return 40 displ))
  130.                (else (return 64 displ))))))
  131.  
  132. ;;; simple branches
  133.  
  134. (define-fg (vax/jbr tag)
  135.   (printer "jbr     ~g"  (? tag))
  136.   (local dot displ field-width)
  137.   (depending-on (disp dot tag) 
  138.                 (choose-a-br (field-width 16) displ)
  139.                 (make-br-fg (? field-width) (? displ)))
  140.   (mark dot))
  141.                                           
  142. (define (make-br-fg width displ)
  143.    (xcond ((fx= width 16) (vax/brb-abs (fixnum-ashr displ 3)))
  144.           ((fx= width 24) (vax/brw-abs (fixnum-ashr displ 3)))
  145.           ((fx= width 48) (vax/jmp-abs (fixnum-ashr displ 3)))))
  146.  
  147. (define (choose-a-br current-width displ)
  148.   (cond ((fx< displ 0)
  149.          (let ((displ (fx+ displ current-width)))
  150.             (cond ((8bit-in-bits? (fx- displ 16)) (return 16 (fx- displ 16)))
  151.                   ((16bit-in-bits? (fx- displ 24)) (return 24 (fx- displ 24)))
  152.                   (else (return 48 (fx- displ 48))))))
  153.         (else
  154.          (cond ((8bit-in-bits? displ) (return 16 displ))
  155.                ((16bit-in-bits? displ) (return 24 displ))
  156.                (else (return 48 displ))))))
  157.  
  158.  
  159. ;;; Displacement in bytes
  160.  
  161. (define-fg (vax/bcc-abs cc abs-displ)
  162.   (printer "b~s    ~s" (jump-op-name (? cc)) (? abs-displ))
  163.   (f u 4 1)
  164.   (f u 4 (jump-op->vax-op (? cc)))
  165.   (f s 8 abs-displ))
  166.  
  167. (define-fg (vax/brb-abs abs-displ)
  168.   (printer "brb     ~s" (? abs-displ))
  169.   (f u 8 #x11)
  170.   (f s 8 abs-displ))
  171.  
  172. (define-fg (vax/brw-abs abs-displ)
  173.   (printer "brw     ~s" (? abs-displ))
  174.   (f u 8 #x31)
  175.   (f s 16 abs-displ))
  176.  
  177. (define-fg (vax/jmp-abs abs-displ)
  178.   (printer "jmp     ~s" (? abs-displ))
  179.   (f u 8 #x17)
  180.   (f u 8 #xEF)
  181.   (f s 32 abs-displ))
  182.  
  183. (define (jump-op->vax-op cc)
  184.   (cond ((fx< cc 0)
  185.          ;;    '#(abs eq  le lt leu ltu) *JUMP-OPS-NEGATIVE*
  186.          (vref '#(1   3   5  9  #xB #xF 7 #xD) (fixnum-negate cc)))
  187.         (else 
  188.          ;;    '#(abs neq gt ge gtu geu) *JUMP-OPS-POSITIVE*
  189.          (vref '#(1   2   4  8  #xA #xE 6 #xC) cc))))
  190.  
  191. ;;;  Labels.   This needs some work.
  192.  
  193. (define (vax/label node)
  194.      (d@pc (data-current-label node)))
  195.  
  196. (define label vax/label)
  197. (define template vax/label)
  198.  
  199. ;;;;-------------------------------
  200.  
  201. ;;; do this right (how?) sometime.  byte, word, long, etc.
  202.  
  203. (define-data-fg (vax/space x)
  204.     (printer ".space  ~s" (? x))
  205.     (f u x 0))
  206.  
  207. ;;; Problem with signed/unsigned
  208.  
  209. (define-data-fg (vax/byte x)
  210.     (printer ".byte   x~x" (? x))
  211.     (f u 8 x))
  212.  
  213. (define-data-fg (vax/word x)
  214.     (printer ".word   x~x" (? x))
  215.     (f u 16 x))
  216.  
  217. ;;; -------------------------- Template stuff.
  218.  
  219.  
  220.  
  221. ;    |  handler offset               |  annotation offset        |H|I| :0
  222. ;    +---------------+---------------+-------------------------------+
  223. ;    |  # ptr cells  |  # scr cells  |   offset within bit vector    | :4
  224. ;    +---------------+---------------+---------------+---------+-+---+
  225. ;    |          <<---- instructions  |   # of args   |    tmplt|0|imm| <--- ptr
  226.                                                    
  227.  
  228. ;;; these fields are in the wrong order.
  229.  
  230. (define-data-fg (vax/template lambda-node handler-ib)
  231. ;    (printer ".tem    ~s,~g" (? lambda-node) (? handler-ib))
  232.     (printer ".template")
  233.     (local template-end)
  234.     (f u 16 (get-template-annotation (? lambda-node)))        
  235.     ;;handler offset
  236.     (f s 16 (fixnum-ashr (from template-end handler-ib) 3))   
  237.     ;;bitv offset
  238.     (f u 16 (fx+ (fixnum-ashr (mark-address (? template-end)) 3) 2)) 
  239.     (f u 16 (get-template-cells (? lambda-node)))
  240.     (f u 1 (if (template-nary (? lambda-node))  1 0))
  241.     (f u 7 (identity header/template))
  242.     (f u 8 (get-template-nargs (? lambda-node)))
  243.     (mark template-end)
  244.     )
  245.  
  246. (define (emit-vax-template code-node code-ib handler-ib template-ib)
  247.    (set (ib-align template-ib) '(24 31 0))
  248.    (emit-to-ib template-ib (vax/template code-node handler-ib))
  249.    (set-ib-follower template-ib code-ib)
  250.    )
  251.  
  252. ;;; A few more machine parameters
  253.  
  254. (set (machine-template-emitter *vax-machine*) emit-vax-template)
  255. (set (machine-cond-branch      *vax-machine*) vax/jcc)
  256. (set (machine-uncond-branch    *vax-machine*) vax/jbr)         
  257.  
  258.